TITLE  ASD
	ENTRY ASD
	EXTERNAL ALLIO.	
M1:	MOVE L
	JUMPGE M2
	JRST M3
M2:	AOS C
	MOVE P
	MOVE 1,C
	MOVEM I(1)
	MOVE A
	MOVE 1,C
	MOVEM PO+5(1)
	MOVE R
	MOVE 2,2(16)
	TLNN 2,40
	TLNN 2,100
	JSA 16,FLOAT
	JUMP 0,R
	MOVE 1,C
	MOVEM AL+5(1)
	MOVE P
	JUMPL P2
	MOVEI 6
	CAMG C
	JRST P1
	JRST M3
P1:	JRST P2
	ASCII	/(6(1X,I1,A5,1H=2PE12.5))/
P2:	MOVEI 1,P1
	OUT. 1,-3
	MOVEI 15,1
M8:	MOVEM 15,I
	MOVE 1,I
	DATA. I(1)
	DATA. 2,PO+5(1)
	DATA. 2,AL+5(1)
	CAIGE 15,6
	AOJA 15,M8
	FIN. 0
	SETZM C
	MOVEI 15,1
	MOVEM 15,I
M11:	SETZM I(15)
	SETZM PO+5(15)
	SETZM AL+5(15)
	CAIGE 15,6
	AOJA 15,M11
M3:	MOVSI 16,TEMP.
	BLT 16,16
	JRA 16,3(16)
ASD:	JUMP 0
	MOVEI TEMP.
	BLT TEMP.+16
	MOVEI TEMP.+16
	PUSH @0(16)
	PUSH @1(16)
	PUSH @2(16)
	JRST M1
TEMP.:	BLOCK 17
P:	0
A:	0
R:	0
L:	0
C:	0
X:	0
I:	0
PO:	BLOCK 6
AL:	BLOCK 6
RE:	BLOCK 6
	EXTERNAL FLOAT
	EXTERNAL FLOUT.
	END
00100		SUBROUTINE ACTES(RO,D,V1,V2)
00150
00200		DIMENSION DIF(-1/1),Z(1783)
00250
00300		REAL D,DP,DEN,DIF,F1,F2,F3,F4,F5,F6,F7,
00350		1 G1,G2,G6,CL,SL,CW,SW,COH,
00400		1 RO,ROP,RO2,VAR,V1,V2,V1P,V2P,V,T,
00480		1 A0,A1,A2,A3,A4,A5,A6,A7,
00485		1 B0,B1,B2,B3,B4,B5,B6,B7
00490
00500		INTEGER I,K
00550
00600		COMMON /EDGEC/ B0,B1,B2,B3,B4,B5,B6,B7,Z
00620
00625		G1=.4082483
00628		G2=.7071068
00631		G6=.5773503
00634		A1=B1/G1
00637		A2=B2/G2
00640		A3=B3/G2
00643		A4=B4/G2
00646		A5=B5/G2
00649		A6=B6/G6
00650		A7=B7/G6
00675		VAR=0.03
00750
00800		DO 60 K=1,3
00900		DO 40 I=-1,1
01000		IF(I.EQ.0 .AND. K.GT.1) GOTO 40
01025
01030		ROP=RO
01032		DP=D
01034		CL=V1
01036		SL=V2
01039
01050		IF(K.NE.1) GOTO 10
01100		V1P=V1-V2*I*VAR
01200		V2P=V2+V1*I*VAR
01240		V=SQRT(V1P**2+V2P**2)
01245		CL=V1P/V
01250		SL=V2P/V
01300		GOTO 30
01400	10	IF(K.NE.2) GOTO 20
01500		DP=D*(1.+I*VAR)
01600		GOTO 30
01700	20	ROP=RO+I*VAR
01750
01800	30	RO2=ROP**2
01900		DEN=1.+2.*RO2
01950		SW=2.8284272*ROP/DEN
02000		CW=(1.-2.*RO2)/DEN
02050		T=DP*0.76749504*(1.-RO2)**2*DEN
02100		F1=G1*T*SW
02150		F2=G2*T*CL
02200		F3=G2*T*SL
02250		F4=G2*T*CL*CW
02300		F5=G2*T*SL*CW
02350		F6=G6*T*(CL**2-SL**2)*SW
02400		F7=G6*T*2.*SL*CL*SW
02500
02510		IF(I.NE.0) GOTO 35
02520		CALL ASD(4,'A1',A1)
02530		CALL ASD(4,'F1',F1)
02540		CALL ASD(4,'A2',A2)
02550		CALL ASD(4,'A3',A3)
02560		CALL ASD(4,'A4',A4)
02570		CALL ASD(4,'A5',A5)
02580		CALL ASD(4,'A6',A6)
02590		CALL ASD(4,'A7',A7)
02600		CALL ASD(4,'F2',F2)
02610		CALL ASD(4,'F3',F3)
02620		CALL ASD(4,'F4',F4)
02630		CALL ASD(4,'F5',F5)
02640		CALL ASD(4,'F6',F6)
02650		CALL ASD(4,'F7',F7)
02700		COH=(A1*F1+A2*F2+A3*F3+A4*F4+A5*F5+A6*F6+A7*F7)/
02710		1 SQRT((A1**2+A2**2+A3**2+A4**2+A5**2+A6**2+A7**2)*
02720		2 (F1**2+F2**2+F3**2+F4**2+F5**2+F6**2+F7**2))
02730		CALL ASD(4,'COH',COH)
03000
03100	35	DIF(I)=(A1-F1)**2+(A2-F2)**2+(A3-F3)**2+
03200		1 (A4-F4)**2+(A5-F5)**2+(A6-F6)**2+(A7-F7)**2
03225	40	CONTINUE
03250
03260		IF(DIF(0).GT.DIF(-1).OR.DIF(0).GT.DIF(1)) GOTO 43
03300		IF((DIF(-1)-DIF(0))*(DIF(0)-DIF(1)).LT.0) GOTO 45
03400	43	CALL ASD(1,'DIF-1',DIF(-1))
03401		CALL ASD(1,'DIF 0',DIF(0))
03402		CALL ASD(1,'DIF+1',DIF(1))
03405		CALL ASD(2,'K',K)
03410		GOTO 60
03415	45	CALL ASD(3,'RO',RO)
03600	60	CONTINUE
03650		RETURN
03700		END